home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Over 1,000 Windows 95 Programs
/
Over 1000 Windows 95 Programs (Microforum) (Disc 1).iso
/
0800
/
crtclass.pas
next >
Wrap
Pascal/Delphi Source File
|
1997-04-10
|
2KB
|
69 lines
(*
Shows how to hook WinCRT's WindowClass.
Public Domain by Mike Caughran
Cedar Island Software
71034.2371@compuserve.com
*)
program HookCRT;
uses WinCRT, WinTypes, WinProcs;
var
OldWndProc : TFarProc;
const
hHookedWnd : HWND = 0;
cm_Exit = 100;
cm_About = 101;
function WindowProc(Window:HWnd; Message,wParam:Word; lParam:LongInt) : LongInt; export;
begin
case Message of
wm_char : if wParam=vk_Return then MessageBeep(0);
wm_LButtonDown : MessageBox(Window,'Left button','Mouse',MB_OK);
wm_Command : begin
case WParam of
cm_About: MessageBox(Window,'Shows how to subclass WinCRT','Hooked CRT',mb_IconExclamation);
cm_Exit: DoneWinCrt;
end;
end;
end;
WindowProc := CallWindowProc(OldWndProc, Window, Message, wParam, lParam);
end;
procedure MakeMenu;
var
Menu : HMenu;
FileMenu : HMenu;
begin
Menu := CreateMenu;
FileMenu := CreateMenu;
AppendMenu(Menu, mf_PopUp or mf_Enabled, FileMenu, 'File');
AppendMenu(FileMenu, mf_Enabled, cm_Exit, 'Exit');
AppendMenu(Menu, mf_Enabled, cm_About, 'About');
SetMenu(hHookedWnd,Menu);
end;
procedure myInitWinCRT;
var
hInstance : THandle;
WindowClass : TWndClass;
begin
GetClassInfo(hInstance, 'TPWinCrt' ,WindowClass);
UnregisterClass('TPWinCRT', hInstance);
WindowClass.hIcon := LoadIcon(0, idi_Exclamation);
WindowClass.hCursor := LoadCursor(0, idc_Arrow);
WindowClass.hbrBackground := CreateSolidBrush(Color_Background);
OldWndProc := tFarProc(WindowClass.lpfnWndProc);
WindowClass.lpfnWndProc := @WindowProc;
RegisterClass(WindowClass);
InitWinCrt;
hHookedWnd := GetActiveWindow;
SetWindowText(hHookedWnd,'Test Sub-Classed WinCRT');
MakeMenu;
end;
begin
myInitWinCrt;
Writeln('Welcome to Subclassed WinCRT World!');
Write('Enter some text : '); readln;
DoneWinCrt;
end.